home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / Yerk 3.6.8 / System source / Proc < prev    next >
Encoding:
Text File  |  1995-04-14  |  4.3 KB  |  108 lines  |  [TEXT/YERK]
  1. \ A pair of words designed to enable Yerk words to be called with a
  2. \  Pascal lookalike stack. Useful when a routine is passed to a Tool-
  3. \  box entry for asynchronous routines.
  4. \  Terminology: Any such Pascal lookalike is called a proc word
  5. \ 10/15/84  RW
  6. \ 12/22/85  CBD Rewrote PSTART, (Hyperdrive fix)
  7. \  8/31/88    rfl    took out meaningless nop in pstart
  8. \  4/01/90    rfl    took out adda.l #$48,a3 since no longer have old yerk header
  9. \ 12/30/90    rfl stack now 3000, and 300 for method stack
  10. \  6/07/91    rfl yerk base now 2c from a5
  11. \ 10/26/91    rfl    increased stack to 7000 for use with system 7
  12. \  4/11/92    rfl    flush cache on :proc if necessary
  13. \  5/02/92    rfl    changed the way a5,a3 are recovered..stored at startup
  14. \                  in a resource called MYA5.
  15. \  4/24/93    rfl    once again, changed the way a5,a3 are recovered. The resource
  16. \                  method moves memory and you don't want that if it is
  17. \                  called by interrupt. So now, to be safe, all procwords
  18. \                  defined in your application will be inited with a5,a3 at
  19. \                  startup time by sticking 'initProcs' into your startup word.
  20. \ 5/18/93    rfl    protected initproc from an assembly proc
  21. \ 1/2/94    rfl    reset stacks to larger values in proc
  22. \ 4/14/95    rfl no longer print out initproc info...it works, so don't worry
  23. Hex
  24.  
  25. 0 value pstartLen
  26.  
  27. \ PSTART - Converts Pascal stack format to our Forth stack format.
  28. \            N.B. - VERY IMPORTANT!!! - This word will never be
  29. \            directly executed. Instead the code will be CMOVE'd
  30. \            into place during the execution of PROC and executed by
  31. \            the routine active via JSR.
  32.  
  33. Create Pstart <[
  34.     600c w,            \         bra.s        next        \ jump over data area
  35.     'type proc ,    \                                \ marker to identify it as proc
  36.     0      ,            \ data                            \ a5 will be here
  37.     0      ,            \                                 \ a3 will be here
  38.     204E w,            \ next    movea.l    a6,a0            \ store return stack ptr
  39.     2C4F w,            \     movea.l    a7,a6                \ save parm stack
  40.     9DFC w, 2328 ,    \     suba.l    #12000,a6            \ allow stack to have 12000 bytes
  41.     2D08 w,            \     move.l    a0,-(a6)            \ save old return stack ptr here
  42.     2D1F w,            \     move.l    (a7)+,-(a6)            \ save return address here
  43.     48E63F1C ,        \     movem.l    d2-d7/a3-a5,-(a6)    \ save these registers, including a5
  44.                                                     \  and a3
  45.     49faffe4 ,        \    lea        data(pc),a4            \ point to a5 data area
  46.     2a5c w,            \    movea.l    (a4)+,a5            \ get a5
  47.     2654 w,            \    movea.l    (a4),a3                \ get a3, ptr to yerk base
  48.  
  49.     2A0E w,            \    move.l    a6,d5                \ let ret stack have only 700
  50.     0485 w, 1f4 ,    \    subi.l    #700,d5                \ and give method stack the rest
  51.     49FA0006 ,        \    lea        6(pc),a4               \ load a4 with ptr to routine
  52. next,
  53.  
  54. \ PEXIT - This code is equally tricky as the above PSTART. This
  55. \          restores the old A6 register and then jumps back to the
  56. \          return location from which the word was called. This
  57. \          code word will be invoked through the colon code, but
  58. \          colon-code will never see it again.
  59. Create P;s <[
  60.     4CDE38FC ,        \ movem.l    (a6)+,d2-d7/a3-a5    \ restore a3 and a5 especially
  61.     205E w,            \ movea.l    (a6)+,a0
  62.     2C5E w,            \ movea.l    (a6)+,a6
  63.     4ED0 w,            \ jmp        (a0)
  64.  
  65. Decimal
  66. ' P;s nfa ' Pstart -  docs 2* -  -> pstartLen    \ if documentation on, subtract 2.
  67.  
  68. \ build a word that looks like a Pascal procedure at its PFA
  69. : :PROC
  70.     ?exec create    \  build hdr, cfa
  71.     ' pstart here pstartLen allot   pstartLen cMove
  72.     cflush    \ flush caches on appropriate machines
  73.     ]> ;    \ enter compilation state
  74.     
  75. : ;PROC   Compile P;s  [Compile] <[   ;  Immediate
  76.  
  77. \ don't assume proc word is always a :proc def..could be assembly
  78. : initProc ( 'cproc -- ) >body dup 2+ @ $ 70726f63 =        \ check for 'proc'
  79.     IF 6 + geta3a5 rot swap over ! 4+ ! ELSE drop THEN ;
  80.  
  81. : (initProcs) { theCfa arg -- } theCfa 6 + @ 'type proc =    \ check for marker
  82.     IF theCfa initProc ( ." initProc: " theCfa >name id. cr) THEN ;            \ it's a procword, so init it
  83.  
  84. \ This word will initialize each procword in your program (at startup time)
  85. : initProcs 'c (initProcs) 0 trav ;
  86.  
  87. \ **** STACK LAYOUT DURING PROCEDURE
  88. \               |
  89. \ method stack  |
  90. \               | <---  d5
  91. \ ______________|
  92. \               |
  93. \ return stack  | <---  a6
  94. \ ______________|
  95. \               |
  96. \ data stack    | <---  A7'  = A7+4 (NEW DATA STACK)
  97. \               | <---- a7
  98. \               |
  99. \               |
  100. \ A6            |
  101. \ (A7) RETURN   |
  102. \ D,A REGISTERS | <---  A6'  = A7-3000 (NEW RETURN STACK)
  103. \               |
  104. \               |
  105. \               | <---  D5'  = A6'-300 (NEW METHODS STACK)
  106. \ 
  107.  
  108.